home *** CD-ROM | disk | FTP | other *** search
/ Web Designer 98 (Professional) / WebDesigner 1.0.iso / tutorials / tutorial / udload.txt < prev   
Encoding:
Text File  |  1997-06-15  |  14.3 KB  |  515 lines
  1. #!/usr/bin/perl
  2.  
  3. # Template : <..> 
  4. # Function Name : init
  5. # Description   : initialize parameters needed by this program 
  6. # Inputs        : none 
  7. # Outputs       : none 
  8. # Return value  : 1 if ok, 0 if error.  
  9. # Calls         :  
  10. # Notes         : 
  11. # Created on Mon Jul 22 14:21:09 PDT 1996 by Steve Hsueh 
  12. sub init
  13. {
  14.  
  15.     $thisurl  = $ENV{'SERVER_URL'}.$ENV{'SCRIPT_NAME'};  
  16.     $upload_dir  = '/usr/home/shpank/public_html/incoming/';       # location for uploaded files
  17.     $authorurl     = 'webmaster@cavalcade-whimsey.com'; # for the mail-to tag
  18.     $ACCESS_DENIED = 'access denied'; 
  19.  
  20.     1; 
  21. } # end of init
  22.  
  23.  
  24.  
  25. # Function Name : print_header 
  26. # Description   : print http header Content-Type 
  27. # Inputs        : none 
  28. # Outputs       : write message to stdout 
  29. # Return value  : 1 if ok, 0 if error.  
  30. # Calls         : print 
  31. # Notes         : none
  32. # Created on Mon Jul 22 12:13:36 PDT 1996 by Steve Hsueh 
  33. sub print_header 
  34. {
  35.     print "Content-Type: text/html\n\n";   
  36.     1;
  37. } # end of print_header 
  38.  
  39.  
  40.  
  41. # Template : <..> 
  42. # Function Name : urldecode 
  43. # Description   : decode url-encoded contents 
  44. # Inputs        : $input 
  45. # Outputs       : %GLOBAL 
  46. # Return value  : 1 if ok, 0 if error.  
  47. # Calls         :  
  48. # Notes         : 
  49. # Creadted on Sun Aug 25 11:30:34 PDT 1996 by Steve Hsueh 
  50. sub urldecode 
  51. {
  52.     local($in) = @_; 
  53.     local($i, @input_list); 
  54.  
  55.     @input_list = split(/&/,$in);
  56.  
  57.     foreach $i (@input_list) {
  58.         $i =~ s/\+/ /g;      # Convert plus's to spaces
  59.  
  60.         # Convert %XX from hex numbers to alphanumeric
  61.         $i =~ s/%(..)/pack("c",hex($1))/ge;
  62.  
  63.         # Split into key and value.
  64.         $loc = index($i,"=");
  65.         $key = substr($i,0,$loc);
  66.         $val = substr($i,$loc+1);
  67.         $GLOBAL{$key} = $val;
  68.     }
  69.  
  70.     1;
  71. } # end of urldecode 
  72.  
  73.  
  74.  
  75.  
  76.  
  77.  
  78. # Template : <..> 
  79. # Function Name : read_net_input 
  80. # Description   : read input from web 
  81. # Inputs        : none 
  82. # Outputs       : %GLOBAL 
  83. # Return value  : 1 if ok, 0 if error.  
  84. # Calls         : sysread(), print(), foreach() 
  85. # Notes         : 
  86. # if GET,  read input from environment variable. if POST, read input from 
  87. # stdin. Parse the content if it is ??, save the content and boundary if it is 
  88. # multipart/form-data.
  89. # Created on Mon Jul 22 12:18:15 PDT 1996 by Steve Hsueh 
  90. sub read_net_input 
  91. {
  92.     local ($i, $loc, $key, $val, $input);
  93.     local($f,$header, $header_body, $len, $buf); 
  94.  
  95.     if ($ENV{'REQUEST_METHOD'} eq "GET")
  96.     { $input = $ENV{'QUERY_STRING'}; }
  97.     elsif ($ENV{'REQUEST_METHOD'} eq "POST")
  98.     {  
  99.     # Need to read TILL we got all bytes, bug fixed in v00.02
  100.     $len = 0;
  101.     $input = ''; 
  102.     while( $len != $ENV{'CONTENT_LENGTH'} ) {
  103.         $buf = ''; 
  104.         $len += sysread(STDIN, $buf, $ENV{'CONTENT_LENGTH'});
  105.         $input .= $buf; 
  106.     }
  107.     }
  108.  
  109.     # conform to RFC1867 for upload specific 
  110.     if( $ENV{'CONTENT_TYPE'} =~ /multipart\/form-data; boundary=(.+)$/ ) {
  111.     $boundary = '--'.$1;  # please refer to RFC1867 
  112.     @list = split(/$boundary/, $input); 
  113.  
  114.     $header_body = $list[1]; 
  115.     $header_body =~ /\r\n\r\n|\n\n/; # separate header and body 
  116.     $header = $`;        # front part
  117.     $body   = $';        # rear part
  118.      $body =~ s/\r\n$//;  # the last \r\n was put in by Netscape
  119.     $GLOBAL{'FILE_CONTENT'} = $body;  
  120.  
  121.     # open(FD,">input.txt"); print FD $input; close(FD);  # for tracking
  122.     # parse header
  123.     $header =~ /filename=\"(.+)\"/; 
  124.     $GLOBAL{'FILE_NAME'} = $1; 
  125.     $GLOBAL{'FILE_NAME'} =~ s/\"//g; # remove "s
  126.         $GLOBAL{'FILE_NAME'} =~ s/\s//g; # make sure no space(include \n, \r..) in the file name 
  127.  
  128.     # parse trailer
  129.     for( $i=2; $list[$i]; $i++) { 
  130.         $list[$i] =~ s/^.+name=$//; 
  131.         $list[$i] =~ /\"(\w+)\"/; 
  132.         $GLOBAL{$1} = $'; 
  133.     }
  134.  
  135.     return 1; 
  136.     }
  137.  
  138.     urldecode($input); 
  139.  
  140.     1;
  141. } # end of read_net_input 
  142.  
  143. # Template : <..> 
  144. # Function Name : read_file 
  145. # Description   : read content of a file into buffer 
  146. # Inputs        : file name 
  147. # Outputs       : file content 
  148. # Return value  : $content if ok, 0 if error.  
  149. # Calls         : open, read, close 
  150. # Notes         : none
  151. # Created on Mon Jul 22 12:29:04 PDT 1996 by Steve Hsueh 
  152. sub read_file 
  153. {
  154.     local($fname) = @_;
  155.     local($content);
  156.  
  157.     open(FILE, "<$fname") || return '';
  158.  
  159.     while(<FILE>)
  160.     {
  161.         $content .= $_;
  162.     }
  163.     close(FILE);
  164.  
  165.     $content; 
  166. } # end of read_file 
  167.  
  168.  
  169.  
  170. # Template : <..> 
  171. # Function Name : read_dir 
  172. # Description   : read the content of a directory 
  173. # Inputs        : $target_dir 
  174. # Outputs       : $dir_content 
  175. # Return value  : $dir_content if ok, 0 if error.  
  176. # Calls         : opendir(), closedir(), readdir() 
  177. # Notes         : $dir_content contain all files in the dir except
  178. # for ./, ../, and hidden files. All files are \n seperated.
  179. # Creadted on Sat Aug 24 13:25:00 PDT 1996 by Steve Hsueh 
  180. sub read_dir 
  181. {
  182.     local($target_dir) = @_ ; 
  183.     local($filename, $dir_content, $open_failed); 
  184.  
  185.     return 0 if( !$target_dir ); 
  186.     opendir(DIR, $target_dir) || do { $open_failed = $!; }; 
  187.  
  188.     $target_dir =~ s/^\.\///;        # remove ./ 
  189.     $target_dir =~ /(.+)\/(.+)\/$/;  # find out upper level 
  190.     $GLOBAL{'UP_LEVEL'} = $1;        # save upper level as a global
  191.  
  192.     if( $target_dir ) { $dir_content = "..back\n\n\n"; }
  193.  
  194.     if( !$open_failed ) {
  195.     while($filename = readdir(DIR)) {
  196.         if( $filename =~ /^\.|^\#|~$/ ) { next; } # skip hidden files
  197.         $dir_content .= "$target_dir$filename\n"; 
  198.     }
  199.     closedir(DIR);
  200.     }
  201.     else {
  202.     $dir_content .= "$ACCESS_DENIED\n"; 
  203.     }
  204.  
  205.     $dir_content;
  206. } # end of read_dir 
  207.  
  208.  
  209.  
  210.  
  211. # Template : <..> 
  212. # Function Name : format_html_output 
  213. # Description   : format the output to be html  
  214. # Inputs        : $dir_content 
  215. # Outputs       : formated dir content 
  216. # Return value  : $formated_content if ok, 0 if error.  
  217. # Calls         :  
  218. # Notes         : this is specifically for file download
  219. # Creadted on Sat Aug 24 14:14:18 PDT 1996 by Steve Hsueh 
  220. sub format_html_output 
  221. {
  222.     local($content) = @_; 
  223.     local(@filelist, $formated_content, $up_level); 
  224.  
  225.     return 0 if (!$content); 
  226.     @filelist = sort(split(/\n/, $content)); 
  227.  
  228.     $formated_content = "<UL>\n"; 
  229.     foreach $f (@filelist) {
  230.     if( $f =~ /^$ACCESS_DENIED$/ ) { $formated_content .= "<li><font color=\#ff0000>$ACCESS_DENIED</font>"; last; }
  231.     if( $f eq '..back' ) { 
  232.         $up_level =  $GLOBAL{'UP_LEVEL'}; 
  233.         $formated_content = "<img src=\"/images/back.gif\"> <a href=".$thisurl.'/'.$up_level.">$f</a><br>\n<UL>\n";
  234.         next; 
  235.     }
  236.  
  237.     if( !$f ) { next; }    
  238.     if( -d $f ) { $f = "$f/";  }
  239.     $formated_content .= '<li><a href='.$thisurl.'/'.$f.">$f</a><br>\n"; 
  240.     }
  241.     $formated_content .= "</UL>\n"; 
  242.     $formated_content; 
  243.  
  244. } # end of format_html_output 
  245.  
  246.  
  247.  
  248.  
  249. # Template : <..> 
  250. # Function Name : show_dir_content 
  251. # Description   : show the content of a directory 
  252. # Inputs        : $dir 
  253. # Outputs       : the content of that directory 
  254. # Return value  : exit after show content, no return 
  255. # Calls         :  
  256. # Notes         : if no param passed in , it defaults to current dir
  257. # the order of input elements in the upload form is important, it effect how
  258. # the browser(Netscape) sends the request. 
  259. # Creadted on Sat Aug 24 14:37:45 PDT 1996 by Steve Hsueh 
  260. sub show_dir_content 
  261. {
  262.     local($dir) = @_; 
  263.     local($files, $f_files); 
  264.  
  265.     $dir = './' if (!$dir); # default to cgi dir
  266.     $files = read_dir($dir); 
  267.     $f_files = format_html_output($files); 
  268.     
  269.     print_header(); 
  270.     print "
  271. <HTML>
  272. <HEAD><TITLE>File UpLoad</TITLE></HEAD>
  273. <BODY BGCOLOR=\"\#000000\" TEXT=\"\#0000ff\" LINK=\"\#FFFF99\" VLINK=\"\#FFFF99\" 
  274. ALINK=\"\#FF8000\">
  275. <center><img src=\"http://206.156.15.206/picts/cavalcade.gif\"></center>
  276. <p>
  277. <center><table width=500><tr><td><font size=-1>
  278. The following form will allow you to upload files to my site. Please only upload graphics, .txt files, 
  279. or .tab files. I log all entries to this site, and any and all warez will <b>NOT BE TOLERATED!</b> So 
  280. please be kind, and I thank you for sending me your files.
  281. <p>
  282. <FORM METHOD=\"POST\"  ENCTYPE=multipart/form-data >
  283. <b>File Name:</b><br> 
  284. <INPUT TYPE=\"file\" NAME=\"file\"  SIZE=35  >
  285. <p>
  286. <INPUT TYPE=HIDDEN NAME=UPLOAD_DIR VALUE=DEFAULT>
  287. <INPUT TYPE=submit NAME=UPLOAD VALUE=UPLOAD > <input type=\"reset\" value=\"Clear\">
  288.  
  289. <INPUT TYPE=HIDDEN NAME=CURRENT_DIR VALUE=\"$dir\">
  290. </FORM>
  291. <HR>
  292. Comments, questions or problems? mail to <a HREF=\"mailto:$authorurl\">$authorurl</a><br>
  293. </font>
  294. </td></tr></table></center>
  295.  
  296. </BODY>
  297. </HTML>
  298. "; 
  299.  
  300.     exit;  
  301.  
  302. } # end of show_dir_content 
  303.  
  304.  
  305.  
  306. # Template : <..> 
  307. # Function Name : show_file_not_found
  308. # Description   : show the file not found message
  309. # Inputs        : nonte
  310. # Outputs       : file not found
  311. # Return value  : exit after show content, no return 
  312. # Calls         :  
  313. # Notes         : none
  314. # Creadted on Sat Aug 24 14:37:45 PDT 1996 by Steve Hsueh 
  315. sub show_file_not_found
  316. {
  317.  
  318.     print_header(); 
  319.     print "<TITLE>Not Found</TITLE><H1>Not Found</H1> The requested object does not exist on this server. The link you followed is either outdated, inaccurate, or the server has been instructed not to let you have it. Connection closed by foreign host.\n";
  320.  
  321.     exit;  
  322.     
  323. } # show_file_not_found
  324.  
  325. # Template : <..> 
  326. # Function Name : start_download 
  327. # Description   : start to download a file 
  328. # Inputs        : file 
  329. # Outputs       : write to sdtout 
  330. # Return value  : 1 if ok, 0 if error.  
  331. # Calls         :  
  332. # Notes         : need to check if the input is a dir or a file
  333. # if dir then call show_dir_content() else start download
  334. # Creadted on Sat Aug 24 14:40:12 PDT 1996 by Steve Hsueh 
  335. sub start_download 
  336. {
  337.     local($target_file) = @_; 
  338.     local($file_name); 
  339.  
  340.  
  341.     $target_file =~ s/^\/|^\\|\s//; 
  342.  
  343.     if( -d $target_file ) { show_dir_content("./$target_file"); }
  344.  
  345.     # check if file exists , though this is not likely to happen
  346.     if ( ! -e "./$target_file")  { show_file_not_found(); }
  347.     
  348.     # get file name
  349.     $file_name = $target_file; 
  350.     $file_name =~ s/.+\/([^\/]+)$/$1/; # for PC system
  351.     $file_name =~ s/.+\\([^\\]+)$/$1/; # for Unix system
  352.  
  353.     # start download
  354.     print "Content-Type: application/x-unknown\n"; 
  355.     print "Content-Disposition: attachment; fillename=$file_name\n\n"; 
  356.     
  357.     print read_file($target_file); 
  358.  
  359.  
  360. 1;
  361. } # end of start_download 
  362.  
  363. # Template : <..> 
  364. # Function Name : show_upload_failed 
  365. # Description   : show upload failed page 
  366. # Inputs        : $reason 
  367. # Outputs       : html page 
  368. # Return value  : no return
  369. # Calls         : print_header, print()
  370. # Notes         : 
  371. # Creadted on Sun Aug 25 13:41:24 PDT 1996 by Steve Hsueh 
  372. sub show_upload_failed 
  373. {
  374.  
  375.     local($reason) = @_; 
  376.  
  377.     print_header(); 
  378.     print "<TITLE>Upload Failed</TITLE><H1>Upload Failed</H1> The requested object was not uploaded to
  379. the server. <br> Reason : $reason. The server may have decided not let you write to the directory
  380. specified. Please contact the <a href=\"mailto:webmaster\@cavalcade-whimsey.com\">webmaster</a> for this
  381. problem. Connection closed by foreign host.\n"; 
  382.     
  383.     exit;  
  384.  
  385. } # end of show_upload_failed 
  386.  
  387. # Template : <..> 
  388. # Function Name : show_upload_success 
  389. # Description   : display a upload success html page 
  390. # Inputs        : uploaded_file 
  391. # Outputs       : html page 
  392. # Return value  : no return
  393. # Calls         : print_header, print() 
  394. # Notes         : the file names is global. we also need to display file size for verification
  395. # Creadted on Sun Aug 25 13:42:50 PDT 1996 by Steve Hsueh 
  396. sub show_upload_success 
  397. {
  398.     local($uploaded_file) = @_; 
  399.     local(@status_list) ; 
  400.  
  401.     # @status_list = stat($uploaded_file); 
  402.     $file_stats = `ls -la $uploaded_file`; 
  403.     @status_list = split(/\s+/,  $file_stats); # bug fix in v00.01 
  404.  
  405.     print_header(); 
  406.     #foreach $s ( @status_list ) { print "==$s== <br>\n"; }
  407.      print "
  408.  
  409. <HTML>
  410. <HEAD><TITLE>File UpLoaded</TITLE>
  411. </HEAD>
  412. <BODY BGCOLOR=\"\#000000\" TEXT=\"\#0000ff\" LINK=\"\#FFFF99\" VLINK=\"\#FFFF99\" 
  413. ALINK=\"\#FF8000\">
  414. <center><img src=\"http://206.156.15.206/picts/cavalcade.gif\"></center> 
  415. <p>
  416. <center><table width=500>
  417. <tr><td><font size=-1>
  418. Thank you for your recent submission. Whenever you get some new pictures or guitar tablature, and you 
  419. think they should be here, than please feel free to send it to me. Thanks again.
  420. <p>
  421. Here is the information on what you uploaded.
  422. <p>
  423. Remote File Name : <FONT COLOR=\#FFFFFF> $GLOBAL{'FILE_NAME'} </FONT> <br>
  424. File Name : $filename <br> 
  425. Location  : My Upload Directory <br>
  426. File Size : $status_list[4] <br>
  427. Local Time: $status_list[5] $status_list[6] $status_list[7] <br>
  428. <p>
  429. I thank you again for uploading these files. If you would like to upload more, just click <a 
  430. href=\"http://206.156.15.206/shpank/udload.cgi\">here</a>.
  431. <p> 
  432. Peace!
  433. <p>
  434. <center><a href=\"mailto:shpank\@beachin.net\">Shpank</a></center>
  435. </font>
  436. </td></tr></table></center>
  437.  
  438. </BODY>
  439. </HTML>
  440. "; 
  441.  
  442.     exit; 
  443.  
  444. } # end of show_upload_success 
  445.  
  446.  
  447.  
  448.  
  449.  
  450. # Template : <..> 
  451. # Function Name : handle_upload 
  452. # Description   : handle file upload from browser 
  453. # Inputs        : none 
  454. # Outputs       : read from stdin and save the file to current directory 
  455. # Return value  : 1 if ok, 0 if error.  
  456. # Calls         :  
  457. # Notes         : 
  458. # Creadted on Sat Aug 24 18:24:30 PDT 1996 by Steve Hsueh 
  459. sub handle_upload 
  460. {
  461.  
  462.     if( !$GLOBAL{'FILE_NAME'} ) { show_file_not_found(); } 
  463.  
  464.     # grep the file name , there is always a / in front of the file name
  465.     #$GLOBAL{'FILE_NAME'} =~ /.+\\([^\\]+)$|([^\/]+)$/; 
  466.     $filename   = $GLOBAL{'FILE_NAME'}; 
  467.     $filename =~ s/.+\\([^\\]+)$|.+\/([^\/]+)$/\1/;     
  468.  
  469.     if( $GLOBAL{'UPLOAD_DIR'} =~ /CURRENT/ ) { # change upload dir to current 
  470.     $GLOBAL{'CURRENT_DIR'} =~ s/\s//g; 
  471.     $upload_dir = $GLOBAL{'CURRENT_DIR'}; 
  472.     }
  473.  
  474.     $write_file = $upload_dir.$filename; 
  475.  
  476.     open(ULFD,">$write_file")  || show_upload_failed("$write_file  $!"); 
  477.     print ULFD $GLOBAL{'FILE_CONTENT'}; 
  478.     close(ULFD); 
  479.  
  480.     show_upload_success($write_file); 
  481.  
  482.     1;
  483. } # end of handle_upload 
  484.  
  485.  
  486.  
  487. # Template : <..> 
  488. # Function Name : main 
  489. # Description   : main function of the script 
  490. # Inputs        : none 
  491. # Outputs       : none 
  492. # Return value  : 1 if ok, 0 if error.  
  493. # Calls         :  
  494. # Notes         : simulate a C style modularity
  495. # Creadted on Sat Aug 24 12:47:18 PDT 1996 by Steve Hsueh 
  496. sub main 
  497. {
  498.     init(); 
  499.     read_net_input();  
  500.  
  501. #  print_header();
  502. #  while( ($n, $v) = each(%ENV)) { print "$n = $v <br>"; } print "<br>"; 
  503. #  while( ($n, $v) = each(%GLOBAL)) { print "$n = $v <br>"; } print "<br>"; 
  504.     
  505.     if( $GLOBAL{'UPLOAD'} ) { handle_upload(); }
  506.     elsif( !$ENV{'PATH_INFO'} || $ENV{'PATH_INFO'} eq '/' ) { show_dir_content(); }
  507.     else { start_download( $ENV{'PATH_INFO'} ); }
  508.  
  509.     1; # for fun
  510. } # end of main 
  511.  
  512. # program starts from here
  513. main(); 
  514.  
  515.